perm filename RECORD.F4[KI,ALS] blob sn#091985 filedate 1974-03-19 generic text, type T, neo UTF8
00100		SUBROUTINE FMAIN
00200		IMPLICIT INTEGER(A-Z)
00300		DIMENSION A(9216),B(9216),C(9216)
00400		DATA SPEED/25600/
00500		DATA NUM/9216/
00600		CALL TORITE(JFN,'LISTEN.TMP')
00700		CALL SETWRT(1,JFN)
00800		CALL STRNGO('ABOUT TO TRY TO ASSIGN ADC ')
00900		CALL SETAD(11,SPEED)
01000		CALL STRNGO(' - SUCCESSFUL')
01100		CALL LFCR
01200		NSEC=5
01300		NSAMP=25600*NSEC
01400		NWORDS=NSAMP/3
01500		TEST=NSAMP-NWORDS*3
01600		IF(TEST.GT.0)NWORDS=NWORDS+1
01700		NPAGES=NWORDS/512
01800		TEST=NWORDS-512*NPAGES
01900		IF(TEST.GT.0)NPAGES=NPAGES+1
02000		NWORDS=512*NPAGES
02100		NITER=NWORDS/(3*NUM)
02200		NLEFT=NWORDS-3*NUM*NITER
02300		FL1=0
02400		FL2=0
02500		FL3=0
02600		IF(NLEFT.GT.NUM)GO TO 1
02700		NL1=NLEFT
02800		IF(NL1.LE.0)FL1=1
02900		IF(NL1.LE.0)NL1=1
03000		NL2=1
03100		FL2=1
03200		NL3=1
03300		FL3=1
03400		GO TO 3
03500	1	CONTINUE
03600		NL1=NUM
03700		NLEFT=NLEFT-NUM
03800		IF(NLEFT.GT.NUM)GO TO 2
03900		NL2=NLEFT
04000		IF(NL2.LE.0)FL2=1
04100		IF(NL2.LE.0)NL2=1
04200		NL3=1
04300		FL3=1
04400		GO TO 3
04500	2	CONTINUE
04600		NL2=NUM
04700		NL3=NLEFT-NUM
04800		IF(NL3.LE.0)FL3=1
04900		IF(NL3.LE.0)NL3=1
05000	3	CONTINUE
     

00100		CALL STRNGO('ABOUT TO TRY TO ASSIGN XGP ')
00200		CALL SETXGP
00300		CALL STRNGO(' - SUCCESSFUL')
00400		CALL LFCR
00500		CALL LOCK
00600		IF(NITER.GT.0)GO TO 4
00700		CALL ADINP1(NL1,A)
00800		CALL ADINP2(NL2,B)
00900		CALL ADINP3(NL3,C)
01000		GO TO 7
01100	4	CONTINUE
01200		CALL ADINP1(NUM,A)
01300		CALL ADINP2(NUM,B)
01400		CALL ADINP3(NUM,C)
01500		IF(NITER.LE.1)GO TO 6
01600		DO 5 LLL=2,NITER
01700		CALL FSTOUT(NUM,A)
01800		CALL ADINP1(NUM,A)
01900		CALL FSTOUT(NUM,B)
02000		CALL ADINP2(NUM,B)
02100		CALL FSTOUT(NUM,C)
02200		CALL ADINP3(NUM,C)
02300	5	CONTINUE
02400	6	CONTINUE
02500		CALL FSTOUT(NUM,A)
02600		CALL ADINP1(NL1,A)
02700		CALL FSTOUT(NUM,B)
02800		CALL ADINP2(NL2,B)
02900		CALL FSTOUT(NUM,C)
03000		CALL ADINP3(NL3,C)
03100	7	CONTINUE
03200		IF(FL1.LE.0)CALL FSTOUT(NL1,A)
03300		CALL ADINP1(1,A)
03400		IF(FL2.LE.0)CALL FSTOUT(NL2,B)
03500		CALL ADINP2(1,B)
03600		IF(FL3.LE.0)CALL FSTOUT(NL3,C)
03700		CALL UNLOCK
03800		CALL RELXGP
03900		CALL STRNGO('XGP RELEASED')
04000		CALL LFCR
04100		CALL RELAD
04200		CALL STRNGO('ADC RELEASED')
04300		CALL LFCR
04400		CALL SCLOSE(JFN)
04500		RETURN
04600		END